home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / The World of Computer Software.iso / tcsel003.zip / SCRT.PAS < prev    next >
Pascal/Delphi Source File  |  1992-10-16  |  4KB  |  157 lines
  1. unit scrt;
  2.  
  3. {
  4.  
  5.   by Trevor J Carlsen
  6.      PO Box 568
  7.      Port Hedland
  8.      Western Australia 6721
  9.      Phone -
  10.        Voice: 61 91 732026
  11.        Data : 61 91 732569
  12.  
  13.    This little unit is intended to replace the crt unit in programs that do
  14.    not require many of that units functions.  As a result the resulting .exe
  15.    code is much smaller.
  16.  
  17.    Released into the public domain 1989
  18.  
  19. }
  20.  
  21. interface
  22.  
  23. function Keypressed: boolean;
  24.   { Returns true if there is a keystroke waiting in the key buffer           }
  25.  
  26. procedure ClrScr;
  27.   { Clears the screen and homes the cursor                                   }
  28.  
  29. procedure ClrKey;
  30.   { Flushes the keystroke buffer                                             }
  31.  
  32. function KeyWord : word;
  33.     inline  ($B4/$00/   {mov  ah,0}
  34.              $CD/$16);  {int  16h}
  35.   { Waits for a keypress and returns a word containing the scancode and      }
  36.   { ascii code for the keypressed                                            }
  37.  
  38. function ExtKey(var k : char; var s : byte): boolean;
  39.   { Gets next keystroke from the keystroke buffer. If it was an extended key }
  40.   { (ie. function key etc.) returns true and k contains the scan code. If a  }
  41.   { normal key then returns false and k contains the character and s the scan}
  42.   { code                                                                     }
  43.  
  44. function ReadKey: char;
  45.   { Gets next keystroke from the buffer. If extended key returns #0          }
  46.  
  47. function NextKey: char;
  48.   { Flushes the keystroke buffer and then returns the next key as ReadKey    }
  49.  
  50. function PeekKey: char;
  51.   { Peeks at the next keypress in the buffer without removing it             }
  52.  
  53. procedure Delay(s : word);
  54.   { Machine independent delay loop for s seconds                             }
  55.  
  56. procedure GotoXY(x,y : byte);
  57.   { Moves the cursor to X, y coordinates                                     }
  58.  
  59. { -------------------------------------------------------------------------- }
  60.  
  61. implementation
  62.  
  63. uses dos;
  64.  
  65. var
  66.   head : word    absolute $0040:$001A;
  67.   tail : word    absolute $0040:$001C;
  68.   time : longint absolute $0040:$006C;
  69.   regs : registers;
  70.  
  71. function Keypressed: boolean;
  72.   begin
  73.     Keypressed := (tail <> head);
  74.   end;
  75.  
  76. procedure ClrScr;                                     { 25 line display only }
  77.  begin
  78.    inline($B4/$06/$B0/$19/$B7/$07/$B5/$00/$B1/$00/$B6/$19/$B2/$4F/
  79.           $CD/$10/$B4/$02/$B7/$00/$B2/$00/$B6/$00/$CD/$10);
  80.  end;
  81.  
  82. procedure ClrKey;
  83.   begin
  84.     head := tail;
  85.   end;
  86.  
  87.  
  88. function ExtKey(var k : char; var s : byte): boolean;
  89.  
  90.   var
  91.     keycode : word;
  92.     al      : byte;
  93.     ah      : byte;
  94.  
  95.   begin
  96.     ExtKey    := false;
  97.     repeat
  98.       keycode := KeyWord;
  99.       al      := lo(keycode);
  100.       ah      := hi(keycode);
  101.       if al = 0 then begin
  102.         ExtKey := true;
  103.         al     := ah;
  104.       end;
  105.   until al <> 0;
  106.   k := chr(al);
  107.   s := al;
  108. end;    {ExtKey}
  109.  
  110. function ReadKey : char;
  111.   var
  112.     Key : byte;
  113.   begin
  114.     Key := lo(KeyWord);
  115.     ReadKey := char(Key);
  116.   end;
  117.  
  118. function NextKey : char;
  119.   begin
  120.     tail := head;
  121.     NextKey := ReadKey;
  122.   end;
  123.  
  124. function PeekKey : char;
  125.   begin
  126.     PeekKey := char(Mem[$40:head]);
  127.   end;
  128.  
  129. procedure delay(s : word);
  130.   var
  131.     start    : longint;
  132.     finished : boolean;
  133.   begin
  134.     start := time;
  135.     repeat
  136.       if time < start then    { midnight rollover occurred during the period }
  137.         dec(start,$1800B0);
  138.       finished := (time > (start + s * 18.2));
  139.     until finished;
  140.   end;
  141.  
  142. procedure gotoXY(x,y : byte);
  143.   begin
  144.     with regs do begin
  145.       ah := $02;
  146.       bh := 0;
  147.       dh := pred(y);
  148.       dl := pred(x);
  149.       intr($10,regs);
  150.     end; { with }
  151.   end;   { gotoXY }
  152.  
  153. end.
  154.  
  155.  
  156.  
  157.